home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / REFERENC / TPR / SOURCE.EXE / RANDFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-07  |  4KB  |  188 lines
  1. { RANDFILE.PAS }
  2. program RandFile;
  3. { Demonstrates random access to a record file }
  4.  
  5. const
  6.   MaxRecords = 100;
  7.  
  8. type
  9.   TDataRecord = record
  10.                   Name        : String[20];
  11.                   PhoneNumber : String[14];
  12.                   Age         : Integer;
  13.                   Available   : Boolean;
  14.                 end;
  15.  
  16. var
  17.   Command     : Char;
  18.   RandomFile  : File of TDataRecord;
  19.  
  20.  
  21.  
  22. procedure AddRecord;
  23. var
  24.   DataRecord : TDataRecord;
  25.   NewName : String[20];
  26.   NewPhone: String[14];
  27.   NewAge  : String[20];
  28.   RecordNum  : Word;
  29.  
  30.  
  31. function  FindFreeRecord : Integer;
  32. { Scans through the file until finding a free or unused record.
  33.   Returns:  The record number of the free record, or if no free
  34.             records are found, then returns MaxRecords + 1.
  35. }
  36. var
  37.   DataRecord : TDataRecord;
  38.   RecNum : Integer;
  39. begin
  40.   RecNum := 0;
  41.   repeat
  42.     Seek( RandomFile, RecNum );
  43.     Read( RandomFile, DataRecord );
  44.     if  not  DataRecord.Available  then
  45.       RecNum := RecNum + 1;
  46.   until (RecNum > MaxRecords) Or (DataRecord.Available);
  47.   FindFreeRecord := RecNum;
  48. end; { FindFreeRecord }
  49.  
  50.  
  51. begin { AddRecord }
  52.  
  53.   RecordNum := FindFreeRecord;
  54.   if  RecordNum > MaxRecords  then
  55.     Writeln('The maximum number of records (',MaxRecords,') are in use.')
  56.   else
  57.   begin
  58.  
  59.     with  DataRecord  do
  60.     begin
  61.       Writeln('Adding record #', RecordNum );
  62.       Write('Enter Name ?');
  63.       Readln( Name );
  64.       Write('Enter # PhoneNumber ?');
  65.       Readln( PhoneNumber );
  66.       Write('Enter Age ?');
  67.       Readln( Age );
  68.       Available := False;
  69.     end;
  70.  
  71.     Seek( Randomfile, RecordNum );
  72.     Write( RandomFile, DataRecord );
  73.   end;
  74.  
  75. end; { AddRecord }
  76.  
  77.  
  78. procedure DisplayRecords;
  79. var
  80.   DataRecord : TDataRecord;
  81.   I : Integer;
  82. begin
  83.   for  I := 0 to MaxRecords  do
  84.   begin
  85.     Seek( Randomfile, I );
  86.     Read( RandomFile, DataRecord );
  87.     if  not DataRecord.Available  then
  88.     { Found a record that is in use }
  89.     begin
  90.       Writeln('Record #', I);
  91.       with  DataRecord  do
  92.         Writeln('Name=', Name,', Phone #=', PhoneNumber,', Age=', Age:3);
  93.       Writeln;
  94.     end; { if begin }
  95.   end; { for begin }
  96. end; { DisplayRecords }
  97.  
  98.  
  99. procedure EditRecord;
  100. var
  101.   DataRecord : TDataRecord;
  102.   Error : Integer;
  103.   NewName : String[20];
  104.   NewPhone: String[14];
  105.   NewAge  : String[20];
  106.   RecordNum  : Word;
  107. begin
  108.  
  109.   Repeat
  110.  
  111.     Write('Enter number of record to edit:  ');
  112.     Readln( RecordNum );
  113.  
  114.     Seek( RandomFile, RecordNum );
  115.     Read( RandomFile, DataRecord);
  116.     if  DataRecord.Available  then
  117.       writeln('Record #', RecordNum, ' does not contain any data.');
  118.  
  119.   Until  not DataRecord.Available;
  120.  
  121.  
  122.   with  DataRecord  do
  123.   begin
  124.     Write('Name =', Name,'(CR=no change) ? ');
  125.     Readln( NewName );
  126.     if  NewName <> '' then
  127.       Name := NewName;
  128.     Write('PhoneNumber =', PhoneNumber, '(CR=no change) ? ');
  129.     Readln( NewPhone );
  130.     if  NewPhone <> ''  then
  131.       PhoneNumber := NewPhone;
  132.     Write('Age =', Age, '(CR=no change) ? ');
  133.     Readln( NewAge );
  134.     if  NewAge <> ''  then
  135.       Val( NewAge, Age, Error);
  136.   end;
  137.   Seek( RandomFile, RecordNum );
  138.   Write( RandomFile, DataRecord );
  139. end; { EditRecord }
  140.  
  141.  
  142. procedure OpenFile;
  143. var
  144.   SampleRecord : TDataRecord;
  145.   Error : Integer;
  146.   I : Integer;
  147. begin
  148.   { Open existing file or create a new random access data file }
  149.   Assign( RandomFile, 'RANDFILE.DAT');
  150.   {$I-}
  151.   Reset( RandomFile );
  152.   {$I+}
  153.   Error := IoResult;
  154.   if  Error <> 0  then
  155.   begin
  156.     { Create and initialize a new file.  Set all records to available }
  157.     Rewrite( RandomFile );
  158.     SampleRecord.Available := True;
  159.     for  I := 0 to MaxRecords  do
  160.       write( RandomFile, SampleRecord );
  161.   end; { if begin }
  162. end; { OpenFile }
  163.  
  164.  
  165. begin { RandFile }
  166.  
  167.   OpenFile;
  168.  
  169.   repeat
  170.     Write('A)dd record, D)isplay records, E)dit record, Q)uit? ');
  171.     Readln( Command );
  172.     Command := Upcase( Command );
  173.     case  Command  of
  174.       'A' :  AddRecord;
  175.       'D' :  DisplayRecords;
  176.       'E' :  EditRecord;
  177.     end; { case }
  178.   until Command = 'Q';
  179.  
  180.   Close( RandomFile );
  181.  
  182.  
  183.   Write('Press Enter when done.');
  184.   Readln;
  185.  
  186.  
  187. end. { program }
  188.